00100	(CDEFUN ACHIEVE(G C FAIL)
00200	:PRO(CSETQ CONTEXT(PUSH-CONTEXT))
00300	
00400	:A(TRY-NEXT G '(GO FAIL))
00500	CONTEXT)
     

00100	(ADD (IF-NEEDED STEP-UP (ON !?(X(ROBOT !,X)) !?(Z(BOX !,Z)))
00200	"AUX"((CS CONTEXT) C1 Z1 Z2 Y)
00300	(REMOVE 'STEP-UP)
00400	(CSETQ Z1(FETCH !"(ON !;X !>Y)))
00500	:L(CSETQ C1(ACHIEVE Z1 CS 'ENDA))
00600	(CSETQ Z2(FETCH !"(STACKED ,Z ,Y)))
00700	(CSETQ CONTEXT(ACHIEVE Z2 C1 'L))
00800	(PRINT !"(STEP_UP ,X ,Y ,Z))
00900	(ADD !"(ON ,X ,Z))
01000	(AU-REVOIR(INSTANCE)) 
01100	:ENDA(CSETQ CONTEXT CS)(ADIEU)
01200	)
01300	)
     

00100	(ADD (IF-NEEDED CLIMB(ONTOP !>(X(ROBOT !,X)))
00200	"AUX"((CS CONTEXT) C1 C2 C3 C4 Z1 Z2 Z3 Z4 Z5 V W Y Z)
00300	(CSETQ Z1(FETCH !"(ON ,X !>Y)))
00400	:L(CSETQ C1(ACHIEVE Z1 CS 'ENDA))
00500	(CSETQ Z2(FETCH !"(STACKED !>V ,Y)))
00600	:M(CSETQ C2 (ACHIEVE Z2 C1 'L))
00700	(CSETQ Z3(FETCH !"(ON ,X ,V)))
00800	:N(CSETQ C3(ACHIEVE Z3 C2 'M))
00900	(CSETQ Z4(FETCH !"(ON ,X !>Z)))
01000	:O(CSETQ C4(ACHIEVE Z4 C3 'N))
01100	(CSETQ Z5(FETCH !"(STACKED !>W ,Z)))
01200	(CSETQ CONTEXT(ACHIEVE Z5 C4 'O))
01300	(ADD !"(ONTOP ,X))
01400	(PRINT !"(ONTOP ,X))
01500	(AU-REVOIR(INSTANCE))
01600	:ENDA(CSETQ CONTEXT CS)(ADIEU))
01700	)
     

00100	(ADD(IF-NEEDED STAND-ON(ON !?(X(ROBOT !,X)) !?(Z(BOX !,Z)))
00200	   "AUX"((CS CONTEXT) C1 Z1 Z2 Y)
00400	(CSETQ Z1(FETCH !"(ATR !;X !>Y)))
00500	:L(CSETQ C1(ACHIEVE Z1 CS 'ENDA))
00700	(CSETQ Z2(FETCH !"(ATB !;Z ,Y)))
00800	(CSETQ CONTEXT(ACHIEVE Z2 C1 'L))
00900	(ADD !"(ON ,X ,Z))
01000	(PRINT !"(STAND-ON ,X ,Z))
01100	(AU-REVOIR(INSTANCE))
01200	:ENDA(CSETQ CONTEXT CS)(ADIEU)
01400	)
01500	)
01600	(DE ROBOT(X)(MEMQ X ROB))(DE BOX(X)(MEMQ X BOX))
01700	(SETQ ROB '(M))(SETQ BOX '(B1 B2 B3))
01800	(ADD '(ATB B1 L))(ADD '(STACKED B2 B1)) (ADD '(STACKED B3 B2))
01900	(ADD '(ATR M L))(CSETQ YY CONTEXT)(CSETQ Z(FETCH '(ON M B1)))(TRY-NEXT Z)
02000	(PRINT CONTEXT)(CSETQ CONTEXT YY)(CSETQ Z(FETCH '(ONTOP M)))
02100	(TRY-NEXT Z)
02200